home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / csdkline.cls < prev    next >
Encoding:
Visual Basic class definition  |  2006-03-06  |  6.6 KB  |  184 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cSDKLine"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. '******************************************************************'
  15. '*                                                                *'
  16. '*                      TurboCAD for Windows                      *'
  17. '*                   Copyright (c) 1993 - 2006                    *'
  18. '*             International Microcomputer Software, Inc.         *'
  19. '*                            (IMSI)                              *'
  20. '*                      All rights reserved.                      *'
  21. '*                                                                *'
  22. '******************************************************************'
  23. ' This sample demostrates how to use PointSnapped event
  24. Option Explicit
  25. Const NUM_TOOLS = 2
  26. Dim b_ToolMode As Integer
  27.  
  28. Const m_EventMaskMouse = imsiEventMouseDown + imsiEventMouseUp + imsiEventMouseMove + imsiEventBeforeRightClick + imsiEventBeforeDoubleClick + imsiEventPointSnapped
  29. Const m_EventMaskApp = imsiEventBeforeExit + imsiEventDrawingNew + imsiEventDrawingOpen + imsiEventDrawingActivate + imsiEventDrawingDeactivate + imsiEventDrawingBeforeClose + imsiEventDrawingBeforeSave + imsiEventWindowResize + imsiEventWindowActivate + imsiEventWindowDeactivate + imsiEventSelectionChange + imsiEventCommandBarControlHit + imsiEventCommandBarControlStatus + imsiEventRunTool + imsiEventPointPick + imsiEventRectanglePick + imsiEventPolygonPick + imsiEventViewBeforeRedraw + imsiEventViewAfterRedraw + imsiEventVirtualIntersectionPick + imsiEventCommandBarControlDone + imsiEventDrop + imsiEventCancel + imsiEventUpdateUndo + imsiEventDrawingAfterSave
  30.  
  31. Const m_EventMask = m_EventMaskMouse + m_EventMaskApp
  32.  
  33.  
  34.  
  35. 'Private m_ptcTool As Tool
  36. Public Property Get Description() As String
  37.     Description = "SDKLine tool example"
  38. End Property
  39. Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long
  40.     ReDim CommandNames(NUM_TOOLS)
  41.     ReDim MenuCaptions(NUM_TOOLS, 2)
  42.     ReDim StatusPrompts(NUM_TOOLS)
  43.     ReDim ToolTips(NUM_TOOLS)
  44.     ReDim Enabled(NUM_TOOLS)
  45.     ReDim WantsUpdates(NUM_TOOLS)
  46.     Dim sICmd As String
  47.     
  48.     CommandNames(0) = "SDK|SDK Line "
  49.     MenuCaptions(0, 0) = "&SDK Line"
  50.     MenuCaptions(0, 1) = "SDK Line" ' toolbar name
  51.     StatusPrompts(0) = "SDK Line"
  52.     ToolTips(0) = "SDK Line"
  53.     Enabled(0) = True
  54.     WantsUpdates(0) = False
  55.     
  56.     CommandNames(1) = "SDK|SDK PolyLine "
  57.     MenuCaptions(1, 0) = "&SDK PolyLine"
  58.     MenuCaptions(1, 1) = "SDK Line" ' toolbar name
  59.     StatusPrompts(1) = "SDK PolyLine"
  60.     ToolTips(1) = "SDK PolyLine"
  61.     Enabled(1) = True
  62.     WantsUpdates(1) = False
  63.     
  64.     
  65.     GetToolInfo = NUM_TOOLS
  66. End Function
  67.  
  68.  
  69. Public Function UpdateToolStatus(ByVal Tool As Tool, Enabled As Boolean, Checked As Boolean) As Boolean
  70.     Enabled = True
  71.     Checked = False
  72.     
  73.     Select Case Tool.Index
  74.         Case 0
  75.             If (m_bRun(0) = True) Then
  76.                 Checked = True
  77.             End If
  78.         Case 1
  79.             If (m_bRun(1) = True) Then
  80.                 Checked = True
  81.             End If
  82.     End Select
  83.     
  84.     UpdateToolStatus = True
  85. End Function
  86.  
  87. Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
  88.     On Error GoTo PictureError
  89.  
  90.     Dim TheImage As New StdPicture
  91.     If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
  92.         Set GetPicture = TheImage
  93.         Exit Function
  94.     End If
  95.  
  96. PictureError:
  97.     Set GetPicture = Nothing
  98. End Function
  99. Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
  100.     On Error GoTo ErrorHandler
  101.  
  102.     'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
  103.     'In this demo, we control the loading by a private variable.
  104.     'Note that if you are loading from .Bmp, or if you are running this tool as a
  105.     '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
  106.     'of the directory in which TCW11.EXE (or IMSIGX.DLL) is located.
  107.  
  108.         'Load from .Res file
  109.     Dim idBitmap%  'BITMAP resource id in .Res file
  110.     If LargeImage Then
  111.         idBitmap% = 101
  112.     Else
  113.         idBitmap% = 102 '101
  114.     End If
  115.     Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
  116.     GetButtonPicture = True
  117.     Exit Function
  118.  
  119. ErrorHandler:
  120.     GetButtonPicture = False
  121. End Function
  122. Public Function Initialize(ByVal Tool As Tool) As Boolean
  123.     On Error GoTo ErrorHandler
  124.     ReDim m_bRun(NUM_TOOLS)
  125.     Dim i As Long
  126.     
  127. '    Set m_tcApp = Tool.Application
  128. '    Set m_theToolEvents = m_tcApp 'Tool.Application
  129.     b_ToolMode = 0
  130.     'm_bRun = False
  131.     For i = 0 To UBound(m_bRun)
  132.         m_bRun(i) = False
  133.     Next i
  134.     
  135.     m_iConnectId = 0
  136.     ghHook = 0
  137.     Initialize = True
  138.     Exit Function
  139. ErrorHandler:
  140.     MsgBox "Method Initialize of " & Tool.Name & " tool failed " & Err.Description
  141.     
  142. End Function
  143. Public Function Run(ByVal theTool As Tool) As Boolean
  144.     Dim i As Long
  145.     On Error GoTo ErrorHandler
  146.     If m_tcApp Is Nothing Then
  147.         Set m_tcApp = theTool.Application
  148.         If m_theToolEvents Is Nothing Then
  149.             Set m_theToolEvents = m_tcApp
  150.         End If
  151.     End If
  152.     m_lLineColor = 0
  153. ' add local menu for our tool
  154.     Set m_ptcTool = theTool
  155.     ghHook = 0
  156.     For i = 0 To UBound(m_bRun)
  157.         m_bRun(i) = False
  158.     Next i
  159.     m_bRun(theTool.Index) = True
  160.     ' we suppose that number of tools and number of members SDKLineTools enum are equal
  161.     ' if you change number of tools please change SDKLineTools enum accordanly
  162.     
  163.     Select Case m_ptcTool.Index
  164.             Case SDKLineTools.SDKLine
  165.                 Set T = New tcEventsHandler
  166.                 m_iConnectId = m_tcApp.ConnectEvents(T, m_EventMask)
  167.                 m_theToolEvents.ToolChangePrompt Me, "SDKLine Tool", False
  168.                 SDKLineToolAddLocalMenu True
  169.             
  170.             Case SDKLineTools.SDKPolyline
  171.                 m_bRun(theTool.Index) = False
  172.                 Set m_theToolEvents = Nothing
  173.                 MsgBox "Add your code here."
  174.     End Select
  175.     m_ActiveTool = theTool.Index
  176.     Exit Function
  177. ErrorHandler:
  178.     MsgBox "Method run of " & theTool.Name & " tool failed " & Err.Description
  179. End Function
  180.  
  181.  
  182.  
  183.  
  184.